TITL DAI FIRMWARE 3E5BC-3E6FC  V1.0  Rev.1
        ORG   :E5BC
*
*
*
**************************************
* ENCODE VARIABLE OR ARRAY REFERENCE *
**************************************
*
* L3E85: Reference to a variable or an array with
*        arguments.
* L3E86: Reference to an array without arguments.
*
* Entry: D : Code: 00: Reference to a value (array
*                      with arguments or variable).
*                  FF: Array name without arguments.
*        C : Next position in input.
*        HL: 1st free position in EBUF.
* Exit:  C,HL updated, AF preserved.
*        DE: Offset to symbol table (to T/L byte).
*        B : T/L byte of name.
*
L3E85   MVI   D,:00
EVR10   PUSH  PSW
        PUSH  D
        CALL  :DDD2     Get 1st char from line,
 REM neglect tab + space
        CALL  :DE02     Check if char is upper case
        JNC   :DA0B     Run 'SYNTAX ERROR' if not
        PUSH  H
        PUSH  PSW       Save 1st char
 REM
* Check if name is a BASIC command:
 REM
        MVI   E,:02     Nr of info bytes -1
        LXI   H,:CBBF   Addr command table
        CALL  :CA34     Find instr in table. On
 REM exit, HL points to string
 REM or after it if not found
        MOV   A,M       )
        ANI   :3F       ) Check if end table reached
        CPI   :25       )
        JNZ   :DA0B     Run 'SYNTAX ERROR' if name
 REM is a command
        ORA   A
 REM
* Check if name is a BASIC function:
 REM
        CALL  :E6FD     Find var.name in input
        LXI   H,:CFE6   Addr function table
        CALL  :CA5A     Find function in table
        JC    :DA0B     Run 'SYNTAX ERROR' if name
 REM is a function
 REM
* Check type marker in input:
 REM
        INR   C         Points to next char in input
        MVI   E,:02     2 bytes in symtab for STR
        MVI   H,:20     String type byte
        CPI   :24
        JZ    :E60E     Jump if STR ('$')
        MVI   E,:04     4 byte in symtab for INT/FPT
        MVI   H,:10     INT type byte
        CPI   :25
        JZ    :E60E     Jump if INT ('%')
        MVI   H,:00     FPT type byte
        CPI   :21
        JZ    :E60E     Jump if FPT ('!')
 REM
* If no type marker given:
 REM
        POP   PSW       Get 1st byte var.name
        LXI   H,:0234   Baseaddr IMPTAB
        CALL  :DE30     Calc offset addr in HL
        MOV   H,M       Get type marker in H
        DCR   C
        JMP   :E60F
 REM
* Handle type marker:
 REM
L3E87   POP   PSW       Get 1st byte of name
L3E88   MOV   A,H       type in A
        ORA   D         OR type (high nibble) with
 REM length (low nibble)
        MOV   D,A       T/L on name in D
        POP   H
        POP   PSW       Get code 00/FF in A
        PUSH  H
        CALL  :E018     ) Update EBUF pointer
        CALL  :E018     ) 2 positions
        ORA   A         Flags on code
        JZ    :E626     Jump if value
 REM
* If name:
 REM
        MOV   A,D       Get T/L byte of name
        ORI   :40       Set bit 6 (array)
        MOV   D,A       Preserve it
        JMP   :E62E
 REM
* If value:
 REM
L3E89   CALL  :DDE0     Get char from line
        CPI   :28       '(' ?
        CZ    :E653     Then encode arguments
*
L3E90   XTHL
        PUSH  H
        MOV   A,D       Get T/L byte on name
        ANI   :30       Type only
        STA   :0136     Set type latest expression
        PUSH  D         Preserve T/L name
        CALL  :CA57     Find variable in symtab
        POP   D         Get T/L name
        CNC   :E67D     Insert variable in symtab
 REM if it is a new one
        MOV   B,D       T/L name in B
        XCHG            Var.addr in symtab in DE
        LHLD  :02A1     Get startaddr symtab
        XCHG            in DE; var.addr in HL
        CALL  :DE1A     Calc offset from begin
 REM symtab in HL
        XCHG            Offset in DE
        POP   H         Retrieve EBUF pntr
        MOV   A,D       Hibyte offset in A
        ORI   :40       Set bit 6 (array)
        MOV   M,A       Hibyte offset in EBUF
        INX   H
        MOV   M,E       Lobyte offset in EBUF
        INX   H
        POP   H
        POP   PSW
        RET
*
* ENCODE ARRAY ARGUMENTS:
*
* An arguments list is encoded into EBUF.
* Format:
*       nr of arg / type of arg / code for expr/
*       < type of arg / code for expr >.
*
* Entry: D : T/L byte of variable name.
*        C : Points to '(' of argument list for
*            array in input.
*        HL: 1st free position EBUF.
* Exit:  D : 'Subscripted' flag.
*        E : Nr of bytes in symtab (02).
*        C,HL updated. B preserved. A=D.
*
EVR50   MVI   E,:00     Parameter count
        PUSH  H
        CALL  :E018     Update EBUF pointer
EVR55   INR   E         Parameter count +1
        INR   C         Skip 'C' or ','
        PUSH  D
        CALL  :E3B2     Encode non-boolean expr
 REM preceeded by its type
        POP   D
        CALL  :DDD2     Get char from line, neglect
 REM tab + space
        CPI   :2C
        JZ    :E659     Get next parameter if it
 REM is ','
        CPI   :29
        JNZ   :DA0B     Run 'SYNTAX ERROR' if
 REM not ')'
        INR   C         Skip ')'
        XTHL            Get old EBUF pntr
        MOV   M,E       Parameter count into EBUF
        POP   H
        MVI   E,:02     2 bytes space in symtab
        MOV   A,D
        ORI   :40       Set type is array
        MOV   D,A       Set flag 'subscripted'
        RET
*
************************
* ENCODE AN ARRAY NAME *
************************
*
EARRN   MVI   D,:FF     Code for name only
        JMP   :E5BE     Encode array name
*
*****************************************
* INSERT A NEW VARIABLE IN SYMBOL TABLE *
*****************************************
*
* The variable name is inserted in the symbol table
* and the value is cleared.
*
* Entry: See CABB.
* Exit:  HL: Points to 2nd T/L byte of entry.
*        AF corrupted, BCDE preserved.
*
EVARI   CALL  :CAB8     Insert var.name in symtab
        PUSH  H
        INX   H         HL pnts after 2nd T/L byte
 REM of entry
        MOV   A,D       Get T/L of name
        ANI   :40
        JNZ   :E695     Jump if array type
 REM
* If number type:
 REM
        MOV   A,D       Get T/L of name
        ANI   :30
        CPI   :20
        JZ    :E695     Jump if string type
        CALL  :CB9E     Clear value in symtab
        POP   H
        RET
 REM
* If string/array type:
 REM
EVI10   MVI   M,:00     ) Clear pointer in symbtab
        INX   H         )
        MVI   M,:00     )
        POP   H
        RET
*
*****************************
* STORE QUOTED TEXT IN EBUF *
*****************************
*
L3E96   MVI   M,:18     Code for quoted string (#18)
 REM into EBUF
        CALL  :E018     Update EBUF pointer
        MVI   E,:FF     Text must end with '"'
        JMP   :E6B5     Into common end
*
*********************************
* STORE UNQUOTED STRING IN EBUF *
*********************************
*
L3E97   MVI   E,:01     Text must end with ','
        MVI   M,:19     Code for unquoted string
 REM (#19) into EBUF
        CALL  :E018     Update EBUF pointer
        JMP   :E6B5     Into common end
*
************************
* STORE TEXT INTO EBUF *
************************
*
* Text in DATA, REM and '***' statements is moved
* into the EBUF.
*
L3E98   CALL  :DDD2     Get char from line, neglect
 REM tab + space
        MVI   E,:02     Text must end with CR
 REM Into common end
*
*************************************
* COMMON END TEXT ENCODING ROUTINES *
*************************************
*
* Entry: C : Points to 1st actual character to be
*            stored.
*        HL: Points to place for length byte in EBUF
*        E : Handling switch:
*             > 1: (but <#80): Text must end with CR
*             = 1: Text will end with ',' (',' is no
*                  inserted into EBUF).
*            <= 0: Text will end at '"' ('"' is not
*                  inserted into the EBUF).
* Exit:  C : Points beyond text in input.
*        HL: Points beyond stored text in EBUF.
*        D : Length of stored text.
*        A : Character which marks end of text.
*        B preserved, E corrupted.
*
L3E99   PUSH  H
        CALL  :E018     Update EBUF pointer
        MVI   D,:00     Set length is 0
L3E100  CALL  :DDE0     Get char from line
        CPI   :0D
        JZ    :E6DB     Jump if char is 'CR'
        CPI   :2C
        JZ    :E6E3     Jump if char is ','
L3E101  INR   C
        CPI   :22
        JNZ   :E6D3     Jump if char is not '"'
        DCR   E
        JM    :E6DF     If done: store length in
 REM EBUF, quit
        INR   E
 REM
* Character into EBUF:
 REM
L3E102  MOV   M,A       Load char in EBUF
        CALL  :E018     Update EBUF pointer
        INR   D
        JMP   :E6BB     Get next char
 REM
* If 'CR':
 REM
L3E103  DCR   E
        JM    :DA0B     If E >= #80: Run 'SYNTAX
 REM ERROR'
L3E104  XTHL
        MOV   M,D       Length in EBUF entry
        POP   H
        RET
 REM
* If ',':
 REM
L3E105  DCR   E
        JZ    :E6DF     If E=0: Store length in
 REM EBUF, quit
        JMP   :E8AB     incr E, get next char
*
********************************************
* FIND BINARY OR UNITARY OPERATOR IN TABLE *
********************************************
*
* Entry/exit: See #3E6F6.
*
L3E106  PUSH  H
        LXI   H,:CF91   Startaddr table
L3E107  MVI   E,:00
        CALL  :CA34     Find instr in table
        MOV   A,M       Get code from table
        POP   H
        RET
*
*************************************
* FIND AN UNITARY OPERATOR IN TABLE *
*************************************
*
* Routine looks for a init. string beginning at
* C in table.
*
* Entry: C : Points to input.
* Exit:  CY=0: Not found:
*              C : Points to 1st valid character
*                  after entry address.
*              A : Contains code info 0.
*              DE = 0, BHL preserved.
*        CY=1: Found:
*              C : Points beyond string found.
*              A : Code byte from table.
*              DE = 0, BHL preserved.
*
L3E108  PUSH  H
        LXI   H,:CFD8   Startaddr table
        JMP   :E6EE     Into previous routine
*
*
*
        END